import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher)
import Utility.Env (getEnv)
import Utility.Base64
-import qualified Utility.RawFilePath as R
import qualified Utility.FileIO as F
import qualified Data.ByteString.Lazy.Char8 as L8
import Utility.Tmp.Dir
import Utility.Rsync
import Utility.FileMode
-import qualified Utility.RawFilePath as R
import qualified Utility.FileIO as F
import qualified Data.Set as S
import qualified Annex.Url as Url
import Remote.Helper.ExportImport
import Annex.SpecialRemote.Config
-import qualified Utility.RawFilePath as R
+import qualified Utility.OsString as OS
import Network.URI
-import qualified System.FilePath.ByteString as P
-import qualified Data.ByteString as S
-
#ifdef WITH_TORRENTPARSER
import Data.Torrent
import qualified Utility.FileIO as F
, remoteStateHandle = rs
}
-downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
+downloadKey :: Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification
downloadKey key _file dest p _ = do
get . map (torrentUrlNum . fst . getDownloader) =<< getBitTorrentUrls key
-- While bittorrent verifies the hash in the torrent file,
unless ok $
get []
-uploadKey :: Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex ()
+uploadKey :: Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex ()
uploadKey _ _ _ _ = giveup "upload to bittorrent not supported"
dropKey :: Maybe SafeDropProof -> Key -> Annex ()
torrentUrlKey u = return $ fromUrl (fst $ torrentUrlNum u) Nothing False
{- Temporary filename to use to store the torrent file. -}
-tmpTorrentFile :: URLString -> Annex RawFilePath
+tmpTorrentFile :: URLString -> Annex OsPath
tmpTorrentFile u = fromRepo . gitAnnexTmpObjectLocation =<< torrentUrlKey u
{- A cleanup action is registered to delete the torrent file
-}
registerTorrentCleanup :: URLString -> Annex ()
registerTorrentCleanup u = Annex.addCleanupAction (TorrentCleanup u) $
- liftIO . removeWhenExistsWith R.removeLink =<< tmpTorrentFile u
+ liftIO . removeWhenExistsWith removeFile =<< tmpTorrentFile u
{- Downloads the torrent file. (Not its contents.) -}
downloadTorrentFile :: URLString -> Annex Bool
downloadTorrentFile u = do
torrent <- tmpTorrentFile u
- ifM (liftIO $ doesFileExist (fromRawFilePath torrent))
+ ifM (liftIO $ doesFileExist torrent)
( return True
, do
showAction "downloading torrent file"
if isTorrentMagnetUrl u
then withOtherTmp $ \othertmp -> do
kf <- keyFile <$> torrentUrlKey u
- let metadir = othertmp P.</> "torrentmeta" P.</> kf
+ let metadir = othertmp </> literalOsPath "torrentmeta" </> kf
createAnnexDirectory metadir
showOutput
ok <- downloadMagnetLink u metadir torrent
- liftIO $ removeDirectoryRecursive
- (fromRawFilePath metadir)
+ liftIO $ removeDirectoryRecursive metadir
return ok
else withOtherTmp $ \othertmp -> do
- withTmpFileIn (toOsPath othertmp) (toOsPath "torrent") $ \f h -> do
+ withTmpFileIn othertmp (literalOsPath "torrent") $ \f h -> do
liftIO $ hClose h
- resetAnnexFilePerm (fromOsPath f)
+ resetAnnexFilePerm f
ok <- Url.withUrlOptions $
- Url.download nullMeterUpdate Nothing u (fromRawFilePath (fromOsPath f))
+ Url.download nullMeterUpdate Nothing u f
when ok $
- liftIO $ moveFile (fromOsPath f) torrent
+ liftIO $ moveFile f torrent
return ok
)
-downloadMagnetLink :: URLString -> RawFilePath -> RawFilePath -> Annex Bool
+downloadMagnetLink :: URLString -> OsPath -> OsPath -> Annex Bool
downloadMagnetLink u metadir dest = ifM download
( liftIO $ do
- ts <- filter (".torrent" `S.isSuffixOf`)
+ ts <- filter (literalOsPath ".torrent" `OS.isSuffixOf`)
<$> dirContents metadir
case ts of
(t:[]) -> do
, Param "--seed-time=0"
, Param "--summary-interval=0"
, Param "-d"
- , File (fromRawFilePath metadir)
+ , File (fromOsPath metadir)
]
-downloadTorrentContent :: Key -> URLString -> FilePath -> Int -> MeterUpdate -> Annex Bool
+downloadTorrentContent :: Key -> URLString -> OsPath -> Int -> MeterUpdate -> Annex Bool
downloadTorrentContent k u dest filenum p = do
torrent <- tmpTorrentFile u
withOtherTmp $ \othertmp -> do
kf <- keyFile <$> torrentUrlKey u
- let downloaddir = othertmp P.</> "torrent" P.</> kf
+ let downloaddir = othertmp </> literalOsPath "torrent" </> kf
createAnnexDirectory downloaddir
f <- wantedfile torrent
- let dlf = fromRawFilePath downloaddir </> f
+ let dlf = downloaddir </> f
showOutput
ifM (download torrent downloaddir <&&> liftIO (doesFileExist dlf))
( do
- liftIO $ moveFile (toRawFilePath dlf) (toRawFilePath dest)
+ liftIO $ moveFile dlf dest
-- The downloaddir is not removed here,
-- so if aria downloaded parts of other
-- files, and this is called again, it will
where
download torrent tmpdir = ariaProgress (fromKey keySize k) p
[ Param $ "--select-file=" ++ show filenum
- , File (fromRawFilePath torrent)
+ , File (fromOsPath torrent)
, Param "-d"
- , File (fromRawFilePath tmpdir)
+ , File (fromOsPath tmpdir)
, Param "--seed-time=0"
, Param "--summary-interval=0"
, Param "--file-allocation=none"
{- Examines the torrent file and gets the list of files in it,
- and their sizes.
-}
-torrentFileSizes :: RawFilePath -> IO [(FilePath, Integer)]
+torrentFileSizes :: OsPath -> IO [(OsPath, Integer)]
torrentFileSizes torrent = do
#ifdef WITH_TORRENTPARSER
- let mkfile = joinPath . map (scrub . decodeBL)
- b <- F.readFile (toOsPath torrent)
+ let mkfile = joinPath . map (scrub . toOsPath)
+ b <- F.readFile torrent
return $ case readTorrent b of
Left e -> giveup $ "failed to parse torrent: " ++ e
Right t -> case tInfo t of
fnl <- getfield "file name"
szl <- map readish <$> getfield "file size"
case (fnl, szl) of
- ((fn:[]), (Just sz:[])) -> return [(scrub fn, sz)]
+ ((fn:[]), (Just sz:[])) -> return [(scrub (toOsPath fn), sz)]
_ -> parsefailed (show (fnl, szl))
else do
v <- getfield "directory name"
case v of
- (d:[]) -> return $ map (splitsize d) files
+ (d:[]) -> return $ map (splitsize (toOsPath d)) files
_ -> parsefailed (show v)
where
- getfield = btshowmetainfo (fromRawFilePath torrent)
+ getfield = btshowmetainfo (fromOsPath torrent)
parsefailed s = giveup $ "failed to parse btshowmetainfo output for torrent file: " ++ show s
-- btshowmetainfo outputs a list of "filename (size)"
- splitsize d l = (scrub (d </> fn), sz)
+ splitsize d l = (scrub (d </> toOsPath fn), sz)
where
sz = fromMaybe (parsefailed l) $ readish $
reverse $ takeWhile (/= '(') $ dropWhile (== ')') $
dropWhile (/= '(') $ dropWhile (== ')') $ reverse l
#endif
-- a malicious torrent file might try to do directory traversal
- scrub f = if isAbsolute f || any (== "..") (splitPath f)
+ scrub f = if isAbsolute f || any (== literalOsPath "..") (splitPath f)
then giveup "found unsafe filename in torrent!"
else f
import qualified Data.Map as M
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
-import qualified System.FilePath.ByteString as P
newtype BorgRepo = BorgRepo { locBorgRepo :: String }
absBorgRepo :: BorgRepo -> IO BorgRepo
absBorgRepo r@(BorgRepo p)
- | borgLocal r = BorgRepo . fromRawFilePath
- <$> absPath (toRawFilePath p)
+ | borgLocal r = BorgRepo . fromOsPath <$> absPath (toOsPath p)
| otherwise = return r
-borgRepoLocalPath :: BorgRepo -> Maybe FilePath
+borgRepoLocalPath :: BorgRepo -> Maybe OsPath
borgRepoLocalPath r@(BorgRepo p)
- | borgLocal r = Just p
+ | borgLocal r = Just (toOsPath p)
| otherwise = Nothing
checkAvailability :: BorgRepo -> Annex Availability
checkAvailability borgrepo@(BorgRepo r) =
- checkPathAvailability (borgLocal borgrepo) r
+ checkPathAvailability (borgLocal borgrepo) (toOsPath r)
listImportableContentsM :: UUID -> BorgRepo -> ParsedRemoteConfig -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))
listImportableContentsM u borgrepo c = prompt $ do
parsefilelist archivename (bsz:f:extra:rest) = case readMaybe (fromRawFilePath bsz) of
Nothing -> parsefilelist archivename rest
Just sz ->
- let loc = genImportLocation f
+ let loc = genImportLocation (toOsPath f)
-- borg list reports hard links as 0 byte files,
-- with the extra field set to " link to ".
-- When the annex object is a hard link to
-- importable keys, so avoids needing to buffer all
-- the rest of the files in memory.
in case ThirdPartyPopulated.importKey' loc reqsz of
- Just k -> (loc, (borgContentIdentifier, retsz k))
+ Just k -> (fromOsPath loc, (borgContentIdentifier, retsz k))
: parsefilelist archivename rest
Nothing -> parsefilelist archivename rest
parsefilelist _ _ = []
borgContentIdentifier :: ContentIdentifier
borgContentIdentifier = ContentIdentifier mempty
--- Convert a path file a borg archive to a path that can be used as an
+-- Convert a path from a borg archive to a path that can be used as an
-- ImportLocation. The archive name gets used as a subdirectory,
-- which this path is inside.
--
--
-- This scheme also relies on the fact that paths in a borg archive are
-- always relative, not absolute.
-genImportLocation :: RawFilePath -> RawFilePath
+genImportLocation :: OsPath -> OsPath
genImportLocation = fromImportLocation . ThirdPartyPopulated.mkThirdPartyImportLocation
genImportChunkSubDir :: BorgArchiveName -> ImportChunkSubDir
-genImportChunkSubDir = ImportChunkSubDir . fromImportLocation . ThirdPartyPopulated.mkThirdPartyImportLocation
+genImportChunkSubDir = ImportChunkSubDir . fromImportLocation
+ . ThirdPartyPopulated.mkThirdPartyImportLocation . toOsPath
-extractImportLocation :: ImportLocation -> (BorgArchiveName, RawFilePath)
-extractImportLocation loc = go $ P.splitDirectories $
+extractImportLocation :: ImportLocation -> (BorgArchiveName, OsPath)
+extractImportLocation loc = go $ splitDirectories $
ThirdPartyPopulated.fromThirdPartyImportLocation loc
where
- go (archivename:rest) = (archivename, P.joinPath rest)
- go _ = giveup $ "Unable to parse import location " ++ fromRawFilePath (fromImportLocation loc)
+ go (archivename:rest) = (fromOsPath archivename, joinPath rest)
+ go _ = giveup $ "Unable to parse import location " ++ fromOsPath (fromImportLocation loc)
-- Since the ImportLocation starts with the archive name, a list of all
-- archive names we've already imported can be found by just listing the
mk ti
| toTreeItemType (LsTree.mode ti) == Just TreeSubtree = Just
- ( getTopFilePath (LsTree.file ti)
+ ( fromOsPath (getTopFilePath (LsTree.file ti))
, getcontents (LsTree.sha ti)
)
| otherwise = Nothing
mkcontents ti = do
let f = ThirdPartyPopulated.fromThirdPartyImportLocation $
mkImportLocation $ getTopFilePath $ LsTree.file ti
- k <- fileKey (P.takeFileName f)
+ k <- fileKey (takeFileName f)
return
- ( genImportLocation f
+ ( fromOsPath (genImportLocation f)
,
( borgContentIdentifier
-- defaulting to 0 size is ok, this size
, Param "--format"
, Param "1"
, Param (borgArchive borgrepo archivename)
- , File (fromRawFilePath archivefile)
+ , File (fromOsPath archivefile)
]
-- borg list exits nonzero with an error message if an archive
-- no longer exists. But, the user can delete archives at any
, giveup $ "Unable to access borg repository " ++ locBorgRepo borgrepo
)
-retrieveExportWithContentIdentifierM :: BorgRepo -> ImportLocation -> [ContentIdentifier] -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)
+retrieveExportWithContentIdentifierM :: BorgRepo -> ImportLocation -> [ContentIdentifier] -> OsPath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)
retrieveExportWithContentIdentifierM borgrepo loc _ dest gk _ = do
showOutput
case gk of
return (k, UnVerified)
Left k -> do
v <- verifyKeyContentIncrementally DefaultVerify k
- (\iv -> tailVerify iv (toRawFilePath dest) go)
+ (\iv -> tailVerify iv dest go)
return (k, v)
where
go = prompt $ withOtherTmp $ \othertmp -> liftIO $ do
, Param "--noacls"
, Param "--nobsdflags"
, Param (borgArchive absborgrepo archivename)
- , File (fromRawFilePath archivefile)
+ , File (fromOsPath archivefile)
]
(Nothing, Nothing, Nothing, pid) <- createProcess $ p
- { cwd = Just (fromRawFilePath othertmp) }
+ { cwd = Just (fromOsPath othertmp) }
forceSuccessProcess p pid
-- Filepaths in borg archives are relative, so it's ok to
-- combine with </>
- moveFile (othertmp P.</> archivefile) (toRawFilePath dest)
- removeDirectoryRecursive (fromRawFilePath othertmp)
+ moveFile (othertmp </> archivefile) dest
+ removeDirectoryRecursive othertmp
(archivename, archivefile) = extractImportLocation loc
, getRepo = return r
, gitconfig = gc
, localpath = if ddarLocal ddarrepo && not (null $ ddarRepoLocation ddarrepo)
- then Just $ ddarRepoLocation ddarrepo
+ then Just $ toOsPath $ ddarRepoLocation ddarrepo
else Nothing
, remotetype = remote
, availability = checkPathAvailability
(ddarLocal ddarrepo && not (null $ ddarRepoLocation ddarrepo))
- (ddarRepoLocation ddarrepo)
+ (toOsPath (ddarRepoLocation ddarrepo))
, readonly = False
, appendonly = False
, untrustworthy = False
, Param "-N"
, Param $ serializeKey k
, Param $ ddarRepoLocation ddarrepo
- , File src
+ , File $ fromOsPath src
]
unlessM (liftIO $ boolSystem "ddar" params) $
giveup "ddar failed"
forceSuccessProcess cmd pid
go' _ _ _ _ _ = error "internal"
-retrieve :: forall a. Remote -> Key -> MeterUpdate -> RawFilePath -> Maybe IncrementalVerifier -> (ContentSource -> Annex a) -> Annex a
+retrieve :: forall a. Remote -> Key -> MeterUpdate -> OsPath -> Maybe IncrementalVerifier -> (ContentSource -> Annex a) -> Annex a
retrieve = byteRetriever . retrieve'
retrieve' :: forall a. Remote -> Key -> (L.ByteString -> Annex a) -> Annex a
) where
import Utility.Url
+import Utility.OsPath
data UrlContents
-- An URL contains a file, whose size may be known.
-- There might be a nicer filename to use.
- = UrlContents (Maybe Integer) (Maybe FilePath)
+ = UrlContents (Maybe Integer) (Maybe OsPath)
-- Sometimes an URL points to multiple files, each accessible
-- by their own URL.
- | UrlMulti [(URLString, Maybe Integer, FilePath)]
+ | UrlMulti [(URLString, Maybe Integer, OsPath)]
import Utility.FileSystemEncoding
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as S
+import qualified Data.ByteString.Lazy as L
#ifdef WITH_OSPATH
import System.OsPath as X hiding (OsPath, OsString, unsafeFromChar)
import System.OsPath
fromOsPath = bytesFromOsPath
#endif
+instance OsPathConv L.ByteString where
+ toOsPath = toOsPath . L.toStrict
+ fromOsPath = L.fromStrict . fromOsPath
+
#if defined(mingw32_HOST_OS)
-- On Windows, OsString contains a ShortByteString that is
-- utf-16 encoded. But the input RawFilePath is assumed to
toOsPath = S.fromShort
fromOsPath = S.toShort
+instance OsPathConv L.ByteString where
+ toOsPath = L.toStrict
+ fromOsPath = L.fromStrict
+
unsafeFromChar :: Char -> Word8
unsafeFromChar = fromIntegral . ord
projects / git-annex.git / commitdiff